home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 46 / 046.d81 / aces up (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  8KB  |  246 lines
  1. 100 rem ***aces up***
  2. 110 gosub 1760:mm$="                                      "
  3. 120 poke 53280,0:poke53281,0
  4. 130 poke56334,1:poke53272,21:poke53265,155
  5. 140 printchr$(8);chr$(142);
  6. 150 goto350
  7. 160 poke53280,14:poke53281,14:printchr$(142)"[147][146][213][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][201]";
  8. 170 fora=1to22:print"[221]"spc(38)"[221]";:next
  9. 180 print"[202][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][203][157][157][192]"
  10. 190 fora=217to242:pokea,peek(a)or128:next
  11. 200 print"          loadstar presents:"
  12. 210 print"                               "
  13. 220 print"                aces  up        "
  14. 230 print"                                "
  15. 240 print"             by jason olds      "
  16. 250 print"                                "
  17. 260 print"             copyright 1987     "
  18. 270 print"                                "
  19. 280 print"                                "
  20. 290 print"       press space to continue"
  21. 300 ifpeek(203)<>60then300
  22. 310 goto440
  23. 320 rem
  24. 330 rem
  25. 340 rem
  26. 350 print"[147]loading data..."
  27. 360 ifml=0thenml=1:load"acesup.chars",8,1
  28. 370 dim card$(4,13):gosub 1820
  29. 380 open4,8,4,"0:acesup.cards,s,r"
  30. 390 fora=1to4:forb=1to13:input#4,ca$(a,b):next:next:close4
  31. 400 dim c(52)
  32. 410 dimp(4)
  33. 420 dims(4,13)
  34. 430 n=52:fori=1ton:c(i)=i:nexti:goto160
  35. 440 bl$="       [157][157][157][157][157][157][157]       [157][157][157][157][157][157][157]       [157][157][157][157][157][157][157]       [157][157][157][157][157][157][157]       "
  36. 450 bl$=bl$+"[157][157][157][157][157][157][157]  [144]@    [157][157][157][157][157][157][157]     "
  37. 460 print"[145]do you need intructions (y/n) ?"
  38. 470 geta$:ifa$<>"y"anda$<>"n"then470
  39. 510 rem ***set up cards, and chuffle***
  40. 520 print"[147]":poke 53265,peek(53265)or64:poke53282,1
  41. 530 poke 56334,peek(56334)or1:poke53272,(peek(53272)and240)+12
  42. 540 ifa$="y"thenpoke53280,0:poke53281,0:gosub1970
  43. 550 n=52:fori=1ton-1:r=(n+1-i)*rnd(0):r=int(r)+i:t=c(r):c(r)=c(i):c(i)=t:next
  44. 560 p(1)=0:p(2)=0:p(3)=0:p(4)=0
  45. 570 co=1
  46. 580 print"[147]";
  47. 590 sp=1
  48. 600 p$="[144]@"
  49. 610 ifa$="y"thenpoke53280,0:poke53281,0:gosub1970
  50. 620 print"[147]":poke 53280,0:poke53281,6
  51. 630 rem ***set board***
  52. 640 print"                aces up                 ";
  53. 650 print"[146] j=pointer left      k=pointer right"
  54. 660 print" return=deal cards   space=remove card"
  55. 670 print" p=push card         q=quit game";
  56. 680 rem ***print first card***
  57. 690 poke 2,203:cp=1
  58. 700 ifco=53then880
  59. 705 n=1:gosub1090
  60. 710 n=2:gosub1090
  61. 720 n=3:gosub1090
  62. 730 n=4:gosub1090
  63. 740 gosub 1030
  64. 750 gosub 1740
  65. 760 rem***main***
  66. 770 rem
  67. 780 geta$:ifa$=""then780
  68. 790 if a$="j"thensp=sp-1:ifsp=0thensp=4
  69. 800 if a$="k"thensp=sp+1:ifsp=5thensp=1
  70. 810 if a$=chr$(13)thengosub1740:goto700
  71. 820 ifa$=" "thengoto1140
  72. 830 ifa$="p"then1420
  73. 840 ifa$="q"then1950
  74. 850 gosub1030
  75. 860 goto780
  76. 870 rem ***check for a winner***
  77. 880 ifp(1)=1andp(2)=1andp(3)=1andp(4)=1then900
  78. 890 goto 1610
  79. 900 if s(1,1)=13ors(1,1)=26ors(1,1)=39ors(1,1)=52then920
  80. 910 goto 1610
  81. 920 if s(2,1)=13ors(2,1)=26ors(2,1)=39ors(2,1)=52then940
  82. 930 goto 1610
  83. 940 if s(3,1)=13ors(3,1)=26ors(3,1)=39ors(3,1)=52then960
  84. 950 goto 1610
  85. 960 if s(4,1)=13ors(4,1)=26ors(4,1)=39ors(4,1)=52then980
  86. 970 goto 1610
  87. 980 goto1680
  88. 990 end
  89. 1000 rem ***number to card converter***
  90. 1010 x=int(num/13.1)+1:y=int(13*(1-x))+num
  91. 1020 return
  92. 1030 print"";spc(8);:fora=1top(1)+5:print"";:next:print" "
  93. 1040 print"";spc(15);:fora=1top(2)+5:print"";:next:print" "
  94. 1050 print"";spc(22);:fora=1top(3)+5:print"";:next:print" "
  95. 1060 print"";spc(29);:fora=1top(4)+5:print"";:next:print" "
  96. 1070 print"";spc(sp*7+1);:fora=1top(sp)+5:print"";:next:printp$
  97. 1080 return
  98. 1090 rem  put card in pile 1 2 3 or 4
  99. 1100 num=c(co):gosub1000:p(n)=p(n)+1:
  100. 1110 s(n,p(n))=num:print"";spc(n*7-1);:ifp(n)<>1thenfora=1top(n)-1:print"";:next
  101. 1120 printca$(x,y)
  102. 1130 co=co+1:return
  103. 1140 rem***remove card***
  104. 1150 ifp(sp)=0then1380
  105. 1160 num=s(sp,p(sp)):gosub1000
  106. 1170 b1=x:b2=y:h1=y
  107. 1180 fora=1to4
  108. 1190 ifp(a)=0thengoto1220
  109. 1200 num=s(a,p(a))
  110. 1210 gosub1000:ifb1=xandy>b2thenh1=y
  111. 1220 next
  112. 1230 if h1=b2 then 1380
  113. 1240 d=0:fora=1to4:num=s(a,p(a)):gosub1000:ifb1=xthend=d+1
  114. 1250 next
  115. 1260 ifd=1then1380
  116. 1270 p(sp)=p(sp)-1
  117. 1280 print"";
  118. 1290 ifp(sp)=0then1310
  119. 1300 fora=1top(sp):print"";:next
  120. 1310 printspc(sp*7-1);bl$
  121. 1320 print"";
  122. 1330 ifp(sp)=0then1370
  123. 1340 ifp(sp)=1then1360
  124. 1350 fora=1top(sp)-1:print"";:next
  125. 1360 num=s(sp,p(sp)):printspc(sp*7-1);:gosub1000:printca$(x,y)
  126. 1370 goto760
  127. 1380 print".............can't do that..............[146]"
  128. 1390 gosub1790:fora=1to500:next
  129. 1400 print"                aces up                 [146]";
  130. 1410 goto760
  131. 1420 rem ***push***
  132. 1430 ifsp=0then1380
  133. 1440 ss=0
  134. 1450 fora=4to1step-1:ifp(a)=0thenss=a
  135. 1460 next
  136. 1470 ifss=0then1380
  137. 1480 p(ss)=p(ss)+1:s(ss,1)=s(sp,p(sp)):p(sp)=p(sp)-1
  138. 1490 print"";
  139. 1500 ifp(sp)=0then1520
  140. 1510 fora=1top(sp):print"";:next
  141. 1520 printspc(sp*7-1);bl$
  142. 1530 print"";
  143. 1540 num=s(ss,p(ss)):printspc(ss*7-1);:gosub1000:printca$(x,y)
  144. 1550 print"";
  145. 1560 ifp(sp)=0then1600
  146. 1570 ifp(sp)=1then1590
  147. 1580 fora=1top(sp)-1:print"";:next
  148. 1590 num=s(sp,p(sp)):printspc(sp*7-1);:gosub1000:printca$(x,y)
  149. 1600 goto760
  150. 1610 print"";
  151. 1612 printmm$:printmm$:printmm$"[145][145][145]"
  152. 1620 print"        sorry, no more deals..."
  153. 1630 print"   do you wish to play again (y/n) ?"
  154. 1640 geta$:ifa$<>"y"anda$<>"n"then1640
  155. 1645 poke56334,1:poke2,21:poke53265,27:print"[147]"
  156. 1650 ifa$="y"thenpoke 2,0:goto 160
  157. 1660 ifa$<>"n"then1640
  158. 1662 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
  159. 1664 ifer<>63thenend
  160. 1670 sys 49234:load "hello connect",8:end
  161. 1680 rem ***winner***
  162. 1690 print"[147]";:fora=1to24:print:next
  163. 1695 poke56334,1:poke2,21:poke53265,27:poke53280,.:poke53281,.:poke53272,21
  164. 1700 print"     congratulations ... you won!!":fora=1to10:print:next
  165. 1710 for a=1to100:poke 53280,a and 15:poke 53281,a and 15:for b=1 to 25:next
  166. 1720 next:print""
  167. 1730 poke 53280,0:poke 53281,0:goto1630
  168. 1740 print"deal #";(co-1)/4;" out of 13";
  169. 1745 ifint((co-1)/4)<>13thenprint:goto1780
  170. 1747 print"[159]  your last deal"
  171. 1750 return
  172. 1760 rem setup sid
  173. 1770 sd=54272:for a=sd to sd+24:poke a,0:next
  174. 1780 return
  175. 1790 rem beep
  176. 1800 pokesd+24,15:poke sd+5,31:pokesd+6,208:pokesd,240:pokesd+1,4:pokesd+4,33
  177. 1810 fors=1to200:next:pokesd+4,0:pokesd,0:pokesd+1,0:pokesd+24,0:return
  178. 1820 rem machine language
  179. 1830 for a=49152 to 49296:read b:poke a,b:next
  180. 1840 sys 49194:poke 2,0
  181. 1850 return
  182. 1860 data169,1,141,25,208,162,59,160,216,173,18,208,197,2,176,9,169,29,141,24
  183. 1870 data208,165,2,208,11,162,27,160,200,169,21,141,24,208,169,0,141,18,208,76
  184. 1880 data 128
  185. 1890 data192,173,20,3,141,160,3,173,21,3,141,161,3,120,169,0,141,20,3,169
  186. 1900 data192,141,21,3,169,1,141,26,208,169,27,141,17,208,169,127,141,13,220,88
  187. 1910 data96,120,173,160,3,141,20,3,173,161,3,141,21,3,169,240,141,26,208,169,27
  188. 1920 data141,17,208,169,0,141,13,220,169,120,141,25,208,169,21,141,24,208,32,132
  189. 1930 data255,88,96,248,104,104,173,13,220,41,1,240,3,76,49,234,76,188,254,0,0,0
  190. 1940 data 0
  191. 1950 poke 56334,1:poke 2,21:poke53265,27:poke 53280,0:poke 53281,0
  192. 1960 print"[147]";:goto 1630
  193. 1970 poke2,106:gosub 2450:print"                aces up                 ";
  194. 1980 print"[146][159]aces are high, ranking above kings."
  195. 1990 print"[156]a row of four cards are dealt as above. ";
  196. 2000 print"any card that is lower than another card";
  197. 2010 print"of the same suit may be discarded.      ";
  198. 2020 print"example: the above cards show the ace"
  199. 2030 print"and king of hearts. the king is lower"
  200. 2040 print"than the ace, and may be discarded."
  201. 2050 print"[153]you move the cursor, using the 'j' and"
  202. 2060 print"'k' keys. follow the computer's moves."
  203. 2070 for a=1 to 9000:next:x=1
  204. 2080 for a=1 to 800:next:x=x+1:print"";spc((x-1)*8-1);" ";spc(7);"@"
  205. 2090 ifx<3 then 208